home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
pascal
/
bbskt30a.zip
/
TERM.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-11-10
|
19KB
|
678 lines
{
Term.Pas
A sample terminal program for BBSkit.
Version 1.2; updated for BBSkit 3.0.
Written by Steve Madsen
This program also includes a couple of "features" for debugging. Compile
with the symbol DEBUG defined for the extras. They are:
Press Alt-D in terminal mode for a dump of the UART registers and some
other useful stuff.
Press Alt-I to retrigger the interrupts. This generally restarts a
stopped transmission if there is a problem with the interrupt handler.
May have to hit it a few times, though.
Press F2 to output a >200 character string.
-Dx command line switch lets you open two ports at once. The second
port is COMx and runs at the same bps rate (to start with) as the
standard port. You must Alt-X out of both ports to quit the program.
Switch between them with Left Alt-F1 and Left Alt-F2.
NOTE: intended to be compiled using the registered version of BBSkit. If
you wish to recompile with a demo copy, remove the space before the $ in
the following $DEFINE.
}
{ $DEFINE DEMO}
PROGRAM Term12;
{$X+}
{$M 16384, 0, 131072}
{$DEFINE NOBSP}
Uses CRT, DOS, VC, Protocol, BBSkit, Comm, Util, MTask;
Const
MaxEmu = 4;
Emulations : Array[1..MaxEmu] of String = ('TTY', 'ANSI', 'VT100', 'VT52');
Type
TTerm = object(TBBS)
Baud : Longint;
Capture : Boolean;
Comport : Byte;
TermFlags : TTermMode;
ExitCh : Char;
Printer : Boolean;
Template : Byte;
CONSTRUCTOR Init(IComport : Byte; IBaud : Longint);
PROCEDURE Run; VIRTUAL;
DESTRUCTOR Done; VIRTUAL;
PROCEDURE Baudrate;
PROCEDURE DebugInfo;
PROCEDURE DOSShell;
PROCEDURE Download;
PROCEDURE Emulation;
PROCEDURE EnterAnswerMode;
PROCEDURE EnterOriginateMode;
PROCEDURE Help(var Cmd : Char);
PROCEDURE ReInitModem;
PROCEDURE Status(Msg : String);
PROCEDURE ToggleBackspace;
PROCEDURE ToggleCapture;
PROCEDURE ToggleDuplex;
PROCEDURE TogglePrinter;
PROCEDURE ToggleShowControls;
PROCEDURE Upload;
end;
Var
TaskID : Word;
TaskResult : Word;
Term : TTerm;
Param : Word;
{$IFDEF DEBUG}
DebugTerm : TTerm;
{$ENDIF}
{********************************************************************}
PROCEDURE Usage;
begin
WriteLn('Term usage:');
WriteLn;
WriteLn(ProgramName, ' <comport> <baudrate> [-o]');
WriteLn;
WriteLn(' <comport> can be 1, 2, 3 or 4.');
WriteLn(' <baudrate> can be 300, 600, 1200, 2400, 4800, 9600, 19200,');
WriteLn(' 38400, 57600, or 115200.');
WriteLn;
WriteLn(' -o starts Term without sending the init string');
{$IFDEF DEBUG}
WriteLn;
WriteLn(' -dx opens debug port COMx at same speed. Must be last parameter!');
{$ENDIF}
WriteLn;
WriteLn('example: ', ProgramName, ' 2 2400 { com2, at 2400 bps }');
WriteLn(' ', ProgramName, ' 1 9600 { com1, at 9600 bps }');
end;
{--------------------------------------------------------------------}
PROCEDURE StartATerm(var AtPort); FAR;
begin
if (Word(AtPort) = 0) then
begin
Term.Init(StrToInt(ParamStr(1)), StrToInt(ParamStr(2)));
Term.Run;
Term.Done;
{$IFDEF DEBUG}
end
else
begin
DebugTerm.Init(StrToInt(Copy(ParamStr(ParamCount), 3, 1)), StrToInt(ParamStr(2)));
DebugTerm.Run;
DebugTerm.Done;
{$ENDIF}
end;
end;
{--------------------------------------------------------------------}
CONSTRUCTOR TTerm.Init(IComport : Byte; IBaud : Longint);
begin
TBBS.Init;
{$IFDEF DEBUG}
AllowVCSwitching(True);
{$ELSE}
AllowVCSwitching(False);
{$ENDIF}
Comport := IComport;
Baud := IBaud;
if (not OpenPort(Comport)) then
begin
vcWriteLn('Can''t open comport.');
Halt(1);
end;
SetBpsRate(Comport, Baud);
SetFlowControl(PortIdx, False, False);
SetParity(PortIdx, NoParity);
SetWordLength(PortIdx, 8);
SetStopBits(PortIdx, 1);
TermFlags.Duplex := Full;
TermFlags.ShowControls := False;
TermFlags.Backspace := #8;
Capture := False;
Printer := False;
SetInput(True, False);
ClrScr;
Template := 1;
Status('');
if (ParamCount < 3) or (Lower(ParamStr(3)) <> '-o') then
EnterOriginateMode;
end;
{--------------------------------------------------------------------}
PROCEDURE TTerm.Run;
Const
BigString = 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa'+
'bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb'+
'cccccccccccccccccccccccccccccccccccccccccccccccccccccccc'+
'dddddddddddddddddddddddddddddddddddddddddddddddddddddddd';
begin
Repeat
ExitCh := TerminalMode(TermFlags);
if (ExitCh = #59) then
Help(ExitCh); { F1 = help }
case ExitCh of
{$IFDEF DEBUG}
#60 : begin
SendString(PortIdx, BigString);
Status(IntToStr(PortArray[PortIdx].OutUsed));
end;
#32 : DebugInfo;
#23 : ReInitModem;
{$ENDIF}
#48 : Baudrate;
#36 : DOSShell;
#81 : Download;
#50 : Emulation;
#30 : EnterAnswerMode;
#24 : EnterOriginateMode;
#35 : begin
Hangup;
Status('');
end;
#20 : ToggleBackspace;
#46 : ToggleCapture;
#18 : ToggleDuplex;
#25 : TogglePrinter;
#31 : ToggleShowControls;
#73 : Upload;
end;
Until (ExitCh = #45); { Alt-X = quit }
end;
{--------------------------------------------------------------------}
DESTRUCTOR TTerm.Done;
Var
Online : Boolean;
begin
Online := Carrier(PortIdx);
ClosePort(not Online);
Window(1, 1, 80, TextScreenMaxY);
TextColor(LightGray);
TextBackground(Black);
ClrScr;
TBBS.Done;
if (Online) and (InCommandLine('-D') = 0) then
WriteLn('Warning: DTR not lowered since you are still online.');
end;
{--------------------------------------------------------------------}
{
* We can just double the rate for any step up, *except* for the step
* from 38400 to 57600.
}
PROCEDURE TTerm.Baudrate;
begin
if (Baud <> 38400) then
begin
Baud := Baud SHL 1;
if (Baud > 115200) then
Baud := 300;
end
else
Baud := 57600;
SetBpsRate(Comport, Baud);
Status('');
end;
{--------------------------------------------------------------------}
PROCEDURE TTerm.DebugInfo;
FUNCTION BinaryByte(Value : Byte) : String;
Var
Strn : String;
Idx : Word;
begin
Strn := '';
Idx := $1;
Repeat
if (Value AND Idx = Idx) then
Strn := '1' + Strn
else
Strn := '0' + Strn;
Idx := Idx SHL 1;
Until (Idx = $100);
BinaryByte := Strn;
end;
begin
vcWriteLn('');
vcWrite (' Port: COM' + IntToStr(PortIdx));
vcWrite (' Status flags: ' + BinaryByte(PortArray[Comport].StatusFlg));
vcWriteLn(' Error flags: ' + BinaryByte(PortArray[Comport].ErrorFlg));
vcWrite (' IER: ' + BinaryByte(Port[PortArray[Comport].PortAddr + IER]));
vcWrite (' IIR: ' + BinaryByte(Port[PortArray[Comport].PortAddr + IIR]));
vcWriteLn(' LCR: ' + BinaryByte(Port[PortArray[Comport].PortAddr + LCR]));
vcWrite (' MCR: ' + BinaryByte(Port[PortArray[Comport].PortAddr + MCR]));
vcWrite (' LSR: ' + BinaryByte(Port[PortArray[Comport].PortAddr + LSR]));
vcWriteLn(' MSR: ' + BinaryByte(Port[PortArray[Comport].PortAddr + MSR]));
vcWrite (' SCR: ' + BinaryByte(Port[PortArray[Comport].PortAddr + SCR]));
vcWrite (' OCW1: ' + BinaryByte(Port[OCW1]));
vcWriteLn(' OCW2: ' + BinaryByte(Port[OCW2]));
vcWrite ('OutUsed: ' + Left(IntToStr(PortArray[Comport].OutUsed), 4));
vcWriteLn(' InUsed: ' + IntToStr(PortArray[Comport].InUsed));
vcWriteLn('');
end;
{---------